home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / PRUS101.ZIP / FFILES.INC < prev    next >
Text File  |  1994-12-19  |  8KB  |  265 lines
  1. { FFILES.INC - include file for the PRUSSG unit FDOS to speed up and enhance
  2.   file related operations under DOS / implementation part }
  3.  (***************************************************************************
  4.  
  5.          RELEASE 1.01 - as first contained in the file PRUS101.LZH
  6.                 by Peter Schuette, 2:2452/117.19, GERMANY
  7.  
  8.                --------------------------------------------
  9.                 organized for Fido's PASCAL related echoes    
  10.                --------------------------------------------
  11.  
  12.      08/12/1994 to 09/05/1994 by Orazio Czerwenka, 2:2450/540.55, GERMANY
  13.      09/06/1994 to --/--/---- by Peter Schuette,   2:2452/117.19, GERMANY
  14.  
  15.  
  16.            As far as third party copyrights are not violated this
  17.            source code is hereby placed to the public domain. Use
  18.            it whatever way you want, but use AT YOUR OWN RISK.
  19.  
  20.            In case you should modify the source rather send your
  21.            modifications to the unit's current organizer (see above for
  22.            NM address) than to spread it on your own. This will help to
  23.            keep the unit updated and grant a certain standard to all
  24.            other users as well.
  25.  
  26.            The unit is currently still under work. So it might greatly
  27.            benefit of your participation.
  28.  
  29.            Those who contributed to the following piece of source,
  30.            listed in alphabethical order:
  31.         ================================================================
  32.            Orazio Czerwenka, Horst Kraemer, Wilbert van Leijen,
  33.            Sieghard Schicktanz, Peter Schuette ...
  34.         ================================================================
  35.            YOUR NAME WILL APPEAR HERE IF YOU CONTRIBUTE USEFUL SOURCE.
  36.  
  37.            Credits in your own programs are as welcome as unnecessary.
  38.  
  39.  ***************************************************************************)
  40.  
  41. { ----- VARs and CONSTs for FILEONPATH ------------------------------------- }
  42.  
  43. VAR
  44.   searchCOM: boolean;
  45.   DirEntry: SearchRec;
  46.   SearchName: PathStr;
  47.   SearchPath: DirStr;
  48.   DOSpath: string;
  49.  
  50. CONST
  51.   foundPrevious: boolean = false;
  52.   ProgExt: ARRAY [boolean] OF ExtStr = ('.EXE', '.COM');
  53.  
  54. { -------------------------------------------------------------------------- }
  55.  
  56. function FileExists(FileName:PathStr):boolean;
  57. { Original author: Wilbert van Leijen,
  58.   modified according to proposals
  59.   of Horst Kraemer }
  60. begin
  61.   FileName[Length(FileName)+1]:=#0;
  62.   { the compiler adds #0 faster than BASM does,
  63.     have a look on your debugger; Horst Kraemer }
  64.   asm
  65.     push ds
  66.     push ss
  67.     pop  ds
  68.     lea  dx,filename[1]
  69.     mov  ax,4300h
  70.     int  21h
  71.     mov  @result,false
  72.     jc   @1
  73.     inc  @result
  74. @1: pop  ds
  75.   end
  76. end;
  77.  
  78. { -------------------------------------------------------------------------- }
  79.  
  80. FUNCTION FirstFile (SearchPath: PathStr): boolean;
  81.  BEGIN (* FirstFile *)
  82.    FindFirst (SearchPath, SearchFileAttr, DirEntry);
  83.    FirstFile:= DosError = 0;
  84.  END (* FirstFile *);
  85.  
  86. FUNCTION anotherFile: boolean;
  87.  BEGIN (* anotherFile *)
  88.    FindNext (DirEntry);
  89.    anotherFile:= DosError = 0;
  90.  END (* anotherFile *);
  91.  
  92.  
  93. FUNCTION nextDir (VAR DOSpath: string): DirStr;
  94.  VAR
  95.    sc: byte;
  96.  BEGIN (* nextDir *)
  97.    sc:= Pos (';', DOSpath);
  98.    IF sc <> 0 THEN BEGIN
  99.      nextDir:= FExpand (Copy (DOSpath, 1, pred (sc)));
  100.      Delete (DOSpath, 1, sc);
  101.    END (* IF sc <> 0 *)
  102.    ELSE BEGIN
  103.      nextDir:= FExpand (DOSpath);
  104.      DOSpath:= '';
  105.    END (* ELSE *);
  106.  END (* nextDir *);
  107.  
  108. FUNCTION FileOnPath (FileSpec: PathStr; PathVariable: String;
  109.    prime: boolean): PathStr;
  110.  VAR
  111.    Ext: ExtStr;
  112.  
  113.  PROCEDURE getDOSpath;
  114.   BEGIN (* getDOSpath *)
  115.     IF PathVariable = '' THEN PathVariable:= 'PATH';
  116.     DOSpath:= GetEnv (PathVariable);
  117.     SearchPath:= FExpand ('.');
  118.     SearchPath:= EnsureBackslash (SearchPath);
  119.   END (* getDOSpath *);
  120.  
  121.  
  122.  PROCEDURE searchDOSpath;
  123.   BEGIN (* searchDOSpath *)
  124.  
  125.     REPEAT (* UNTIL prime *)
  126.  
  127.       IF (NOT searchCOM) AND (DOSpath = '') THEN BEGIN
  128.  IF anotherFile
  129.    THEN FileOnPath:= SearchPath+ DirEntry.Name
  130.    ELSE BEGIN
  131.      FileOnPath:= ''; foundPrevious:= false;
  132.    END (* ELSE *);
  133.    prime:= true;
  134.       END (* IF NOT searchCOM AND (DOSpath = '') *)
  135.       ELSE BEGIN
  136.  
  137.  SearchPath:= nextDir (DOSpath);
  138.  SearchPath:= EnsureBackslash (SearchPath);
  139.  prime:= FirstFile (SearchPath+ SearchName);
  140.  
  141.  IF prime
  142.    THEN FileOnPath:= SearchPath+ DirEntry.Name
  143.    ELSE IF searchCOM AND (DOSpath = '') THEN BEGIN
  144.      searchCOM:= false;
  145.      SearchName:= Copy (SearchName, 1, Length (SearchName)- 4)+
  146.     ProgExt [false];
  147.      getDOSpath;
  148.      prime:= FirstFile (SearchPath+ SearchName);
  149.      IF prime THEN FileOnPath:= SearchPath+ DirEntry.Name;
  150.    END (* IF searchCOM AND (DOSpath = '') *);
  151.  END (* ELSE *);
  152.     UNTIL prime;
  153.   END (* searchDOSpath *);
  154.  
  155.  
  156.  BEGIN (* FileOnPath *)
  157.    IF prime THEN foundPrevious:= false;
  158.  
  159.    IF foundPrevious THEN BEGIN
  160.  
  161.      IF anotherFile THEN BEGIN
  162.        FileOnPath:= SearchPath+ DirEntry.Name;
  163.      END (* IF anotherFile *)
  164.      ELSE searchDOSpath;
  165.  
  166.    END (* IF foundPrevious *)
  167.    ELSE BEGIN
  168.      {$V-}
  169.      FSplit (FileSpec, SearchPath, SearchName, Ext);
  170.      {$V+}
  171.      IF SearchName = '' THEN SearchName:= '*';
  172.      IF Ext = '' THEN BEGIN
  173.        searchCOM:= true;
  174.        Ext:= ProgExt [true];
  175.      END (* IF Ext = '' *);
  176.      SearchName:= SearchName+ Ext;
  177.  
  178.      IF SearchPath = ''
  179.        THEN getDOSpath
  180.        ELSE BEGIN
  181.   SearchPath:= FExpand (SearchPath);
  182.   DOSpath:= '';
  183.        END (* ELSE *);
  184.  
  185.      foundPrevious:= true;
  186.  
  187.      IF FirstFile (SearchPath+ SearchName)
  188.        THEN FileOnPath:= SearchPath+ DirEntry.Name
  189.        ELSE searchDOSpath;
  190.  
  191.    END (* ELSE *);
  192.  END (* FileOnPath *);
  193.  
  194. { -------------------------------------------------------------------------- }
  195.  
  196. Function DelFile;
  197. { Mailed in by Peter Schuette }
  198. VAr R: Registers;
  199. Begin {DelFile}
  200.  
  201.   {append #0 to filename to make it ASCIIZ}
  202.   FileName[Length(FileName)+1] := #0;
  203.  
  204.   R.AH := $41;
  205.   R.DS := Seg(FileName);
  206.   R.DX := Ofs(FileName)+1;
  207.  
  208.   Intr($21, R);
  209.  
  210.   If (R.Flags and FCarry) <> 0 Then DelFile := R.AX
  211.   Else DelFile := 0;
  212. End; {DelFile}
  213.  
  214. { -------------------------------------------------------------------------- }
  215.  
  216. function RenFile;
  217. { Mailed in by Peter Schuette }
  218. Var R: Registers;
  219. Begin {RenFile}
  220.   OldName[Length(OldName)+1] := #0;
  221.   NewName[Length(NewName)+1] := #0;
  222.  
  223.   R.AH := $56;
  224.   R.DS := Seg(OldName);
  225.   R.DX := Ofs(OldName)+1;
  226.  
  227.   R.ES := Seg(NewName);
  228.   R.DI := Ofs(NewName)+1;
  229.  
  230.   Intr($21, R);
  231.  
  232.   If (R.Flags and FCarry) <> 0 Then RenFile := R.AX
  233.   Else RenFile := 0;
  234. End; {RenFile}
  235.  
  236. { --------------------------------------------------------------------------
  237.  
  238.  Änderungen:
  239.  ===========
  240.  in 1.00:
  241.  --------
  242. 12.08.1994 -ocz FileExist, RenFile und DelFile aus FDOS in FFILES
  243.                 ausgelagert.
  244.            -ocz FileExist umbenannt in FileExists (=Korrektur eines
  245.                 Tipfehlers :->).
  246.            -ocz *** NEU! *** Sieghard Schicktanzs OnPath als FileOnPath
  247.                 aufgenommen.
  248.                 Typendeklaration VarString = string[20] aufgegeben, da die
  249.                 Umgebungsvariable PATH ab DOS 5.0 mit Tricks die doppelte
  250.                 Länge eines ComStr annehmen können soll. Das wären
  251.                 (theoretisch) bis zu 2x127 = 254 Zeichen. Den Typen VarString
  252.                 also der Einfachheit halber durch den vordefinierten Typen
  253.                 String ersetzt.
  254.                 FileOnPath's FileExists umbenannt in FirstFile. Es kann nicht
  255.                 durch die bereits vorhandene ASM-Variante ersetzt werden, da
  256.                 es den von FileOnPath benötigten SearchRec mittels FindFirst
  257.                 initialisieren muß, damit die Routine funktioniert.
  258.                 Die Konstante DataFiles wurde zur flexibleren Handhabung im
  259.                 Interface-Teil über FFILES.DEC als typisierte Konstante
  260.                 SearchFileAttr exportiert.
  261.                 Die Prozedur w_Backslash wurde zur Vermeidung doppelter
  262.                 Routinen in den Projekt-Units durch die Funktion EnsureBack-
  263.                 Slash aus FSTR ersetzt.
  264.  
  265.   -------------------------------------------------------------------------- }